home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyResourceObjects.p < prev    next >
Encoding:
Text File  |  1996-10-12  |  2.5 KB  |  116 lines  |  [TEXT/CWIE]
  1. unit MyResourceObjectss;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Resources;
  7.         
  8.     const
  9.         res_by_id = 0;
  10.         res_by_name = -1;
  11.  
  12.     type
  13.         ResourceObject = record
  14.                 data: Handle;
  15.                 fs: FSSpec;
  16.                 typ: ResType;
  17.                 id: integer;
  18.                 name: Str255;
  19.                 attributes: integer;
  20.                 readonly: boolean;
  21.             end;
  22.  
  23.     function GetResourceObject (var res: ResourceObject; index: integer): OSErr;
  24.     function PutResourceObject (var res: ResourceObject): OSErr;
  25.     procedure DestroyResourceObject (var res: ResourceObject);
  26.  
  27. implementation
  28.  
  29.     uses
  30.         Errors;
  31.         
  32.     procedure DestroyResourceObject (var res: ResourceObject);
  33.     begin
  34.         DisposeHandle(res.data);
  35.         res.data := nil;
  36.     end;
  37.  
  38.     function GetResourceObject (var res: ResourceObject; index: integer): OSErr;
  39.         var
  40.             h: Handle;
  41.             err: OSErr;
  42.             resfile: integer;
  43.     begin
  44.         res.data := nil;
  45.         res.readonly := false;
  46.         SetResLoad(false);
  47.         resfile := FSpOpenResFile(res.fs, fsRdWrPerm);
  48.         err := ResError;
  49.         if err <> noErr then begin
  50.             res.readonly := true;
  51.             resfile := FSpOpenResFile(res.fs, fsRdPerm);
  52.             err := ResError;
  53.         end;
  54.         if err = noErr then begin
  55.             if index = res_by_id then begin
  56.                 h := Get1Resource(res.typ, res.id);
  57.             end
  58.             else if index = res_by_name then begin
  59.                 h := Get1NamedResource(res.typ, res.name);
  60.             end
  61.             else begin
  62.                 h := Get1IndResource(res.typ, index);
  63.             end;
  64.             if h = nil then begin
  65.                 if index > 0 then begin
  66.                     err := resNotFound;
  67.                 end else if res.readonly then begin
  68.                     err := wrPermErr;
  69.                 end;
  70.                 res.attributes := 0;
  71.             end else begin
  72.                 GetResInfo(h, res.id, res.typ, res.name);
  73.                 res.attributes := GetResAttrs(h);
  74.                 SetResAttrs(h, 0);
  75.                 SetResLoad(true);
  76.                 h := Get1Resource(res.typ, res.id);
  77.                 SetResAttrs(h, res.attributes);
  78.                 DetachResource(h);
  79.                 res.data := h;
  80.             end;
  81.             CloseResFile(resfile);
  82.         end;
  83.         SetResLoad(true);
  84.         GetResourceObject := err;
  85.     end;
  86.  
  87.     function PutResourceObject (var res: ResourceObject): OSErr;
  88.         var
  89.             h: Handle;
  90.             err: OSErr;
  91.             resfile: integer;
  92.     begin
  93.         SetResLoad(false);
  94.         resfile := FSpOpenResFile(res.fs, fsRdWrPerm);
  95.         err := ResError;
  96.         if err = noErr then begin
  97.             h := Get1Resource(res.typ, res.id);
  98.             if h <> nil then begin
  99. {    SetResInfo(h, -1, 'Backup');}
  100.                 RemoveResource(h);
  101.             end;
  102.             AddResource(res.data, res.typ, res.id, res.name);
  103.             err := ResError;
  104.             if err = noErr then begin
  105.                 WriteResource(res.data);
  106.                 SetResAttrs(res.data, res.attributes);
  107.                 err := ResError;
  108.                 DetachResource(res.data);
  109.             end;
  110.             CloseResFile(resfile);
  111.         end;
  112.         SetResLoad(true);
  113.         PutResourceObject := err;
  114.     end;
  115.  
  116. end.